Statistical network models have gained popularity in analyzing multivariate psychological data. These models often interpret network parameters as reflecting causal relationships, making it a form of causal discovery. However, recent research has shown that network models may not perform well as causal discovery tools for discovering acyclic causal structures (DAGs), and alternative methods are preferred for this task (Ryan, Bringmann, and Schuurman 2022).
But, acyclic causal models may not be suitable for some psychological phenomena, such as psychopathologies, which we expect to have cycles or feedback loop relationships between symptoms. While cyclic causal discovery methods have been developed in the computer science literature, they are not widely applied or well understood in empirical practice.
To address this gap, the main paper provides an accessible introduction to the basics of cyclic causal discovery for empirical researchers (Park 2023). It examines three different cyclic causal discovery methods and investigates their performance in typical psychological research contexts through a simulation study.
This supplementary material provides a more detailed analysis of the main simulation study. We omitted these results from the paper due to space constraints. In this supplementary material, we show the estimated PAGs and their associated measures of accuracy and uncertainty for each simulation condition. Additionally, we provide extra results on the running time of the algorithms used in the study.
2 Simulation Conditions
Below, we show the directed cyclic graph (DCG) and the corresponding true ancestral graph for each condition. There are in total eight conditions: model size (\(p = 5\), \(p = 10\)) \(\times\) density (sparse, dense) \(\times\) presence of latent confounder (presence, absence).
Below, we present the most frequently estimated PAG for each sample size (N) from each algorithm. The graphs are obtained by picking the most frequent type of edge-endpoint produced by algorithms out of 500 simulations. Additionally, we present the matrix plots of the correct estimation and uncertainty for each condition. The darker the color (blue/red) is, the higher the rate of correct estimation (blue) or uncertainty (red).
par(mfrow=c(2,5))vec <-list("CCD-5p-sparse"= mat_5psparse, "FCI-5p-sparse"= fci_5psparse, "CCI-5p-sparse"= cci_5psparse)graphs_5psparse <-list()for(i inseq_along(vec)){## high-freq graphs graphs_5psparse[[i]] <- vec[[i]] %>%map(~high_freq(.x, p =5) %>% plotAG)## correct prop plots vec[[i]] %>%imap(~prop_correct(.x, trueag_5psparse, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob(glue::glue("Correct Proportion {names(vec[[i]])}"), face ="bold", size =18, family ="Palatino"))## uncertainty prop plots vec[[i]] %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob(glue::glue("Uncertainty {names(vec)[i]}"), face ="bold", size =18, family ="Palatino"))}corprop_plots_5psparse <-list()# prop correctfor(i inseq_along(vec)){ corprop_plots_5psparse[[i]] <- vec[[i]] %>%imap(~prop_correct(.x, trueag_5psparse, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob(glue::glue("Correct Proportion {names(vec[[i]])}"), face ="bold", size =18, family ="Palatino"))}ucprop_plots_5psparse <-list()# prop uncertainfor(i inseq_along(vec)){ ucprop_plots_5psparse[[i]] <- vec[[i]] %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob(glue::glue("Uncertainty {names(vec)[i]}"), face ="bold", size =18, family ="Palatino"))}
See code here.
## CCD 5p sparse case# high frequencypar(mfrow=c(2,5))mat_5psparse %>%map(~high_freq(.x, p =5) %>% plotAG)
See code here.
# prop correctmat_5psparse %>%imap(~prop_correct(.x, trueag_5psparse, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCD-5p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainmat_5psparse %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCD-5p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
## FCI 5p sparse case# high frequencypar(mfrow=c(2,5))fci_5psparse %>%map(~high_freq(.x, p =5) %>% plotAG)
See code here.
# prop correctfci_5psparse %>%imap(~prop_correct(.x, trueag_5psparse, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion FCI-5p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainfci_5psparse %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty FCI-5p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
## CCI 5p sparse case# high frequencypar(mfrow=c(2,5))cci_5psparse %>%map(~high_freq(.x, p =5) %>% plotAG)
See code here.
# prop correctcci_5psparse %>%imap(~prop_correct(.x, trueag_5psparse, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCI-5p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertaincci_5psparse %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCI-5p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
## CCD 5p dense case# high frequency par(mfrow=c(2,5))mat_5pdense %>%map(~high_freq(.x, p =5) %>% plotAG)
See code here.
# prop correctmat_5pdense %>%imap(~prop_correct(.x, trueag_5pdense, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCD-5p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainmat_5pdense %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCD-5p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
## FCI 5p dense case# high frequency par(mfrow=c(2,5))fci_5pdense %>%map(~high_freq(.x, p =5) %>% plotAG)
See code here.
# prop correctfci_5pdense %>%imap(~prop_correct(.x, trueag_5pdense, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion FCI-5p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainfci_5pdense %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty FCI-5p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
## CCI 5p dense case# high frequency par(mfrow=c(2,5))cci_5pdense %>%map(~high_freq(.x, p =5) %>% plotAG)
See code here.
# prop correctcci_5pdense %>%imap(~prop_correct(.x, trueag_5pdense, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCI-5p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertaincci_5pdense %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCI-5p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
## CCD 10p sparse case# high frequency par(mfrow=c(2,5))mat_10psparse %>%map(~high_freq(.x, p =10) %>% plotAG)
See code here.
# prop correctmat_10psparse %>%imap(~prop_correct(.x, trueag_10psparse, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCD-10p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainmat_10psparse %>%imap(~prop_uncertain(.x, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCD-10p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
## FCI 10p sparse case# high frequency par(mfrow=c(2,5))fci_10psparse %>%map(~high_freq(.x, p =10) %>% plotAG)
See code here.
# prop correctfci_10psparse %>%imap(~prop_correct(.x, trueag_10psparse, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion FCI-10p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainfci_10psparse %>%imap(~prop_uncertain(.x, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty FCI-10p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
## CCI 10p sparse case# high frequency par(mfrow=c(2,5))cci_10psparse %>%map(~high_freq(.x, p =10) %>% plotAG)
See code here.
# prop correctcci_10psparse %>%imap(~prop_correct(.x, trueag_10psparse, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCI-10p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertaincci_10psparse %>%imap(~prop_uncertain(.x, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCI-10p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
## CCD 10p dense case# high frequency par(mfrow=c(2,5))mat_10pdense %>%map(~high_freq(.x, p =10) %>% plotAG)
See code here.
# prop correctmat_10pdense %>%imap(~prop_correct(.x, trueag_10pdense, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCD-10p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainmat_10pdense %>%imap(~prop_uncertain(.x, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCD-10p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
## FCI 10p dense case# high frequency par(mfrow=c(2,5))fci_10pdense %>%map(~high_freq(.x, p =10) %>% plotAG)
See code here.
# prop correctfci_10pdense %>%imap(~prop_correct(.x, trueag_10psparse, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion FCI-10p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainfci_10pdense %>%imap(~prop_uncertain(.x, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty FCI-10p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
## CCI 10p dense case# high frequency par(mfrow=c(2,5))cci_10pdense %>%map(~high_freq(.x, p =10) %>% plotAG)
See code here.
# prop correctcci_10pdense %>%imap(~prop_correct(.x, trueag_10psparse, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCI-10p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertaincci_10pdense %>%imap(~prop_uncertain(.x, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCI-10p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
## CCD 5p sparse LV case# high frequencypar(mfrow=c(2,5))mat_5pLVsparse %>%map(~high_freq(.x, p =5) %>% plotAG)
See code here.
# prop correctmat_5pLVsparse %>%imap(~prop_correct(.x, trueag_5psparseLV, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCD-5p-LV-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainmat_5pLVsparse %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCD-5p-LV-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# high frequencypar(mfrow=c(2,5))fci_5pLVsparse %>%map(~high_freq(.x, p =5) %>% plotAG)
See code here.
# prop correctfci_5pLVsparse %>%imap(~prop_correct(.x, trueag_5psparseLV, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion FCI-5p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainfci_5pLVsparse %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty FCI-5p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
## CCI 5p sparse case# high frequencypar(mfrow=c(2,5))cci_5pLVsparse %>%map(~high_freq(.x, p =5) %>% plotAG)
See code here.
# prop correctcci_5pLVsparse %>%imap(~prop_correct(.x, trueag_5psparseLV, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCI-5p-LV-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertaincci_5pLVsparse %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCI-5p-LV-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
## CCD 5p dense LV case# high frequencypar(mfrow=c(2,5))mat_5pLVdense %>%map(~high_freq(.x, p =5) %>% plotAG)
See code here.
# prop correctmat_5pLVdense %>%imap(~prop_correct(.x, trueag_5pdenseLV, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCD-5p-LV-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainmat_5pLVdense %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCD-5p-LV-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# high frequencypar(mfrow=c(2,5))fci_5pLVdense %>%map(~high_freq(.x, p =5) %>% plotAG)
See code here.
# prop correctfci_5pLVdense %>%imap(~prop_correct(.x, trueag_5pdenseLV, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion FCI-5p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainfci_5pLVdense %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty FCI-5p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
## CCI 5p sparse case# high frequencypar(mfrow=c(2,5))cci_5pLVdense %>%map(~high_freq(.x, p =5) %>% plotAG)
See code here.
# prop correctcci_5pLVdense %>%imap(~prop_correct(.x, trueag_5pdenseLV, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCI-5p-LV-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertaincci_5pLVdense %>%imap(~prop_uncertain(.x, p =5) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCI-5p-LV-dense", face ="bold", size =18, family ="Palatino"))
See code here.
## CCD 10p sparse LV case# high frequencypar(mfrow=c(2,5))mat_10pLVsparse %>%map(~high_freq(.x, p =10) %>% plotAG)
See code here.
# prop correctmat_10pLVsparse %>%imap(~prop_correct(.x, trueag_10psparseLV, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCD-10p-LV-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainmat_10pLVsparse %>%imap(~prop_uncertain(.x, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCD-10p-LV-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# high frequencypar(mfrow=c(2,5))fci_10pLVsparse %>%map(~high_freq(.x, p =10) %>% plotAG)
See code here.
# prop correctfci_10pLVsparse %>%imap(~prop_correct(.x, trueag_10psparseLV, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion FCI-10p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainfci_10pLVsparse %>%imap(~prop_uncertain(.x, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty FCI-10p-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
## CCI 5p sparse case# high frequencypar(mfrow=c(2,5))cci_10pLVsparse %>%map(~high_freq(.x, p =10) %>% plotAG)
See code here.
# prop correctcci_10pLVsparse %>%imap(~prop_correct(.x, trueag_10psparseLV, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCI-10p-LV-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertaincci_10pLVsparse %>%imap(~prop_uncertain(.x, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCI-10p-LV-sparse", face ="bold", size =18, family ="Palatino"))
See code here.
## CCD 10p dense LV case# high frequencypar(mfrow=c(2,5))mat_10pLVdense %>%map(~high_freq(.x, p =10) %>% plotAG)
See code here.
# prop correctmat_10pLVdense %>%imap(~prop_correct(.x, trueag_10pdenseLV, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCD-10p-LV-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainmat_10pLVdense %>%imap(~prop_uncertain(.x, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCD-10p-LV-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# high frequencypar(mfrow=c(2,5))fci_10pLVdense %>%map(~high_freq(.x, p =10) %>% plotAG)
See code here.
# prop correctfci_10pLVdense %>%imap(~prop_correct(.x, trueag_10pdenseLV, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion FCI-10p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertainfci_10pLVdense %>%imap(~prop_uncertain(.x, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty FCI-10p-dense", face ="bold", size =18, family ="Palatino"))
See code here.
## CCI 5p sparse case# high frequencypar(mfrow=c(2,5))cci_10pLVdense %>%map(~high_freq(.x, p =10) %>% plotAG)
See code here.
# prop correctcci_10pLVdense %>%imap(~prop_correct(.x, trueag_10pdenseLV, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="blue") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Correct Proportion CCI-10p-LV-dense", face ="bold", size =18, family ="Palatino"))
See code here.
# prop uncertaincci_10pLVdense %>%imap(~prop_uncertain(.x, p =10) %>%# long format reshape2::melt() %>%ggplot(aes(x = Var2, y = Var1, fill = value, label= value)) +geom_tile() +geom_text() +# reverse factor levelscale_y_discrete(limits=rev) +scale_fill_gradient(low="grey90", high="red") +labs(x ="", y="", title = glue::glue("N = {N[.y]}")) ) %>% ggpubr::ggarrange(plotlist = .,ncol =5, nrow =2, common.legend =TRUE, legend ="bottom") %>% ggpubr::annotate_figure(top =text_grob("Uncertainty CCI-10p-LV-dense", face ="bold", size =18, family ="Palatino"))
4 Overall Performance Evalulation
Here we summarize the performance of the algorithms across all conditions using the evaluation metrics: structural Hamming distance (SHD), precision, recall, and uncertainty. Each point represents the average value of each metric and shaded area represents interquartile range (IQR).
See code here.
## ============================## Create neat dataframe## ============================## Compute average precision & recall and corresponding sd for each conditionpre_rec <-list(# put all the results together in a list res_ccd5psparse, res_fci5psparse, res_cci5psparse, res_ccd10psparse, res_fci10psparse, res_cci10psparse, res_ccd5pdense, res_fci5pdense, res_cci5pdense, res_ccd10pdense, res_fci10pdense, res_cci10pdense, res_ccd5pLVsparse, res_fci5pLVsparse, res_cci5pLVsparse, res_ccd5pLVdense, res_fci5pLVdense, res_cci5pLVdense, res_ccd10pLVsparse, res_fci10pLVsparse, res_cci10pLVsparse, res_ccd10pdense, res_fci10pLVdense, res_cci10pLVdense) %>%# transpose dfmap(~ sjmisc::rotate_df(.x) %>%# add sample size (N) inforename_with(~paste0(.x, "N = ", rep(N, each=8))) %>%# think about how to deal with NAs or do I want to define sth. else instead of NAs.# na.omit(.x) %>% # get the average and sd dplyr::summarise(across(everything(.), list(mean =~mean(., na.rm=T), sd =~sd(., na.rm=T))))) %>%bind_rows() %>%mutate(algorithm =rep(c("CCD", "FCI", "CCI"), 8),condition =rep(c("5p_sparse", "10p_sparse", "5p_dense", "10p_dense", "5p_LVsparse", "5p_LVdense", "10p_LVsparse", "10p_LVdense"), each=3),netsize = stringr::str_split(condition, "_", simplify=T)[,1],latentvar =ifelse(stringr::str_detect(condition, "LV")==TRUE, "with LC", "without LC"),densities = stringr::str_remove(stringr::str_split(condition, "_", simplify=T)[,2], "LV") ) %>%# brings the algorithm and condition names firstrelocate(where(is.character), .before =where(is.numeric)) %>%# convert it to a long format tidyr::pivot_longer(!c(algorithm, condition, netsize, latentvar, densities), names_to ="metric", values_to ="value") %>%# Add sample size column (N) & clean up the column name mutate(N = stringr::str_extract(metric, "(?<=[N =])\\d+"),metric = stringr::str_replace_all(metric, "[0-9.]+|[N =]", "")) ## Compute average uncertainty rate and corresponding sd for each conditionuncertainties <-bind_rows(# bind all results from each condition"CCD_5p-sparse"= uncer_ccd5psparse, "FCI_5p-sparse"= uncer_fci5psparse, "CCI_5p-sparse"=uncer_cci5psparse, "CCD_10p-sparse"=uncer_ccd10psparse, "FCI_10p-sparse"= uncer_fci10psparse, "CCI_10p-sparse"= uncer_cci10psparse, "CCD_5p-dense"=uncer_ccd5pdense, "FCI_5p-dense"=uncer_fci5pdense, "CCI_5p-dense"=uncer_cci5pdense, "CCD_10p-dense"=uncer_ccd10pdense, "FCI_10p-dense"=uncer_fci10pdense, "CCI_10p-dense"=uncer_cci10pdense, "CCD_5p-LVsparse"=uncer_ccd5pLVsparse, "FCI_5p-LVsparse"=uncer_fci5pLVsparse, "CCI_5p-LVsparse"=uncer_cci5pLVsparse, "CCD_10p-LVsparse"=uncer_ccd10pLVsparse, "FCI_10p-LVsparse"=uncer_fci10pLVsparse, "CCI_10p-LVsparse"=uncer_cci10pLVsparse,"CCD_5p-LVdense"=uncer_ccd5pLVdense, "FCI_5p-LVdense"=uncer_fci5pLVdense, "CCI_5p-LVdense"=uncer_cci5pLVdense, "CCD_10p-LVdense"=uncer_ccd10pLVdense, "FCI_10p-LVdense"=uncer_fci10pLVdense, "CCI_10p-LVdense"=uncer_cci10pLVdense, .id="id") %>%group_by(id) %>%# get the average and sdsummarise_all(list(means = mean, sds = sd)) %>%mutate(algorithm = stringr::str_split(id, "_", simplify = T)[,1],condition = stringr::str_split(id, "_", simplify = T)[,2],netsize = stringr::str_split(condition, "-", simplify=T)[,1],latentvar =ifelse(stringr::str_detect(condition, "LV")==TRUE, "with LC", "without LC"),densities = stringr::str_remove(stringr::str_split(condition, "-", simplify=T)[,2], "LV") ) %>% tidyr::pivot_longer(!c(algorithm, condition, id, netsize, latentvar, densities), names_to ="name", values_to ="value") %>%mutate(N = stringr::str_extract(stringr::str_split(name, "_", simplify = T)[,1], "(\\d)+"),statistics = stringr::str_split(name, "_", simplify = T)[,2]) %>% dplyr::select(-id, -name) %>%relocate(where(is.character), .before =where(is.numeric))## Compute average SHD values and corresponding sd for each conditionSHDs <-bind_rows(# bind all results from each condition"CCD_5p-sparse"= SHD_ccd5psparse, "FCI_5p-sparse"= SHD_fci5psparse, "CCI_5p-sparse"=SHD_cci5psparse, "CCD_10p-sparse"= SHD_ccd10psparse, "FCI_10p-sparse"= SHD_fci10psparse, "CCI_10p-sparse"= SHD_cci10psparse, "CCD_5p-dense"= SHD_ccd5pdense, "FCI_5p-dense"=SHD_fci5pdense, "CCI_5p-dense"=SHD_cci5pdense, "CCD_10p-dense"= SHD_ccd10pdense, "FCI_10p-dense"=SHD_fci10pdense, "CCI_10p-dense"=SHD_cci10pdense, "CCD_5p-LVsparse"=SHD_ccd5pLVsparse, "FCI_5p-LVsparse"=SHD_fci5pLVsparse, "CCI_5p-LVsparse"=SHD_cci5pLVsparse, "CCD_10p-LVsparse"=SHD_ccd10pLVsparse, "FCI_10p-LVsparse"=SHD_fci10pLVsparse, "CCI_10p-LVsparse"=SHD_cci10pLVsparse, "CCD_5p-LVdense"=SHD_ccd5pLVdense, "FCI_5p-LVdense"=SHD_fci5pLVdense, "CCI_5p-LVdense"=SHD_cci5pLVdense, "CCD_10p-LVdense"=SHD_ccd10pLVdense, "FCI_10p-LVdense"=SHD_fci10pLVdense, "CCI_10p-LVdense"=SHD_cci10pLVdense, .id="id") %>%group_by(id) %>%# get the average and sdsummarise_all(list(means = mean, sds = sd)) %>%mutate(algorithm = stringr::str_split(id, "_", simplify = T)[,1],condition = stringr::str_split(id, "_", simplify = T)[,2],netsize = stringr::str_split(condition, "-", simplify=T)[,1],latentvar =ifelse(stringr::str_detect(condition, "LV")==TRUE, "with LC", "without LC"),densities = stringr::str_remove(stringr::str_split(condition, "-", simplify=T)[,2], "LV") ) %>% tidyr::pivot_longer(!c(algorithm, condition, id, netsize, latentvar, densities), names_to ="name", values_to ="value") %>%mutate(N = stringr::str_extract(stringr::str_split(name, "_", simplify = T)[,1], "(\\d)+"),statistics = stringr::str_split(name, "_", simplify = T)[,2]) %>% dplyr::select(-id, -name) %>%relocate(where(is.character), .before =where(is.numeric)) ## ============================## Create figures## ============================## specify the common figure themeMyTheme <-theme(plot.title =element_text(face ="bold", family ="Palatino", size =15, hjust=0.5),plot.subtitle =element_text(face ="italic", family ="Palatino", size =15, hjust=0.5),axis.text=element_text(face ="bold",family ="Palatino", size =11),axis.text.x =element_text(angle =45, hjust =1.2, vjust =1.2),axis.title =element_text(face ="bold",family ="Palatino", size =12),legend.text =element_text(face ="bold", family ="Palatino", size =12),legend.position="bottom",strip.text =element_text(face="bold", size=13, family ="Palatino"),strip.background =element_rect(fill="#f0f0f0", linetype ="solid", color="gray"),strip.placement ="outside",panel.border =element_rect(color ="#DCDCDC", fill =NA),panel.spacing.y =unit(4, "mm"))## SHD figureSHDs %>% tidyr::pivot_wider(names_from = statistics, values_from=value) %>%ggplot(aes(x=as.numeric(N), y=means, group = algorithm, colour = algorithm, fill = algorithm)) +# add line plotsgeom_line(aes(group = algorithm)) +# add scattered pointsgeom_point(size=1) +# add interquartile range (IQR)geom_ribbon(aes(ymin=means+qnorm(0.25)*sds, ymax=means+qnorm(0.75)*sds), alpha=0.15, color=NA) +# specify custom colorsscale_colour_manual(values =c("#FF0000", "#00A08A", "#F2AD00"), name="") +scale_fill_manual(values =c("#FF0000", "#00A08A", "#F2AD00"), name="") +labs(x="N", y="", title ="") +# apply the themetheme_minimal() + MyTheme +# create a facet ggh4x::facet_nested(factor(netsize, levels =c("5p", "10p"), labels =c("p = 5", "p = 10")) ~factor(latentvar, levels =c("without LC", "with LC")) +factor(densities, levels=c("sparse", "dense")), scales ="free_y", switch="y") +scale_x_continuous(breaks=c(50, 2500, 5000, 7500, 10000)) +ggtitle("SHD")
The running time of the algorithms, presented in log(ms), indicates that FCI generally takes the shortest time, while CCD takes the longest across all conditions.
Ryan, Oisín, Laura F. Bringmann, and Noémi K. Schuurman. 2022. “The Challenge of Generating Causal Hypotheses Using Network Models.”Structural Equation Modeling: A Multidisciplinary Journal 0 (0): 1–18. https://doi.org/10.1080/10705511.2022.2056039.